home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / TOOLS / PC_DEMO.ZIP / SHOW_PIC.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-04-15  |  4.3 KB  |  154 lines
  1. PROGRAM Show_Pic (Input, Output);
  2. { THIS PROGRAM READS A PC-DEMO .PIC FILE AND DISPLAYS IT }
  3. { BY DIRECTLY ADDRESSING THE SCREEN MEMORY }
  4.  
  5.   CONST
  6.     Columns40           = 40;       { COLUMNS FROM 1 TO 40 }
  7.     Columns80           = 80;       { COLUMNS FROM 1 TO 80 }
  8.     LastLine            = 25;       { LINES FROM 1 TO 25 }
  9.     MaxtString          = 76;       { MAX CHARS IN FILE NAME W/ PATH AND EXT }
  10.     FourKB              = 4000;     { FILE SIZE OF 80-COLUMN PICTURE }
  11.     TwoKB               = 2000;     { FILE SIZE OF 40-COLUMN PICTURE }
  12.     PictureExt          = '.PIC';   { FILE EXTENSION FOR FULL PICTURES }
  13.     Null                = '';       { NULL STRING }
  14.  
  15.   TYPE
  16.     N_PictureType       = ARRAY [1..LastLine, 1..Columns40] OF Integer;
  17.                                     { ARRAY OF 40-COLUMN PICTURE DATA }
  18.     W_PictureType       = ARRAY [1..LastLine, 1..Columns80] OF Integer;
  19.                                     { ARRAY OF 80-COLUMN PICTURE DATA }
  20.  
  21.     ParString           = String [255];
  22.                                     { VARIABLE LENGTH STRING PARAMETER TYPE }
  23.  
  24.     Result              =           { REGISTERS AND FLAGS }
  25.       RECORD
  26.         AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : integer;
  27.       END;     {RECORD}
  28.  
  29.   VAR
  30.     I                   : Byte;
  31.  
  32.     Size                : Integer;
  33.  
  34.     IName,
  35.     OName               : ParString;
  36.  
  37.     W_Picture          : W_PictureType;
  38.                                     { THE 80-COLUMN PICTURE }
  39.  
  40.     N_Picture          : N_PictureType Absolute W_Picture;
  41.                                     { THE 40-COLUMN PICTURE }
  42.  
  43.     N_InFile            : FILE OF N_PictureType;
  44.     W_InFile            : FILE OF W_PictureType;
  45.  
  46.     TestFile            : FILE OF Byte;
  47.  
  48.     N_InPtr             : ^ N_PictureType;
  49.     W_InPtr             : ^ W_PictureType;
  50.  
  51.     Res                 : Result;
  52.  
  53.  
  54.   FUNCTION Exist (FileName : ParString) : Boolean;
  55.   { SEES IF A FILE EXISTS }
  56.  
  57.     VAR
  58.       TestFile  : FILE;
  59.  
  60.     BEGIN    { Exist }
  61.       Assign (TestFile, FileName);
  62.  
  63. {$I-}
  64.  
  65.       Reset (TestFile);
  66.  
  67. {$I+}
  68.  
  69.       Exist := (IOResult = 0);
  70.       Close (TestFile);
  71.     END;     { Exist }
  72.  
  73.  
  74.  
  75.   PROCEDURE ConvertCase (VAR Strng : ParString);
  76.   { CONVERTS STRINGS TO UPPER CASE }
  77.  
  78.     VAR
  79.       I : Byte;
  80.  
  81.     BEGIN    { ConvertCase }
  82.       FOR I := 1 TO Length (Strng) DO
  83.         Strng [I] := UpCase (Strng [I]);
  84.     END;     { ConvertCase }
  85.  
  86.  
  87.   BEGIN     { Show_Pic }
  88.     Intr ($11, Res);                { EQUIPMENT CHECK }
  89.     IF Res.AX AND $30 = $30
  90.       THEN                          { MONOCHROME }
  91.         BEGIN
  92.           N_InPtr := Ptr ($B000, 0);
  93.           W_InPtr := Ptr ($B000, 0);
  94.         END
  95.       ELSE                          { COLOR }
  96.         BEGIN
  97.           N_InPtr := Ptr ($B800, 0);
  98.           W_InPtr := Ptr ($B800, 0);
  99.         END;
  100.     IName := Null;
  101.     IF ParamCount = 0
  102.       THEN
  103.         BEGIN
  104.           Writeln ('Command must be of form: SHOW_PIC <name>');
  105.           Exit;
  106.         END;
  107.     IName := ParamStr (1);
  108.     Convertcase (IName);
  109.     IName := IName + PictureExt;
  110.     IF NOT Exist (IName)
  111.       THEN
  112.        BEGIN
  113.          Writeln ('ERROR! File not found ' + IName);
  114.          Exit;
  115.        END;
  116.     Assign (TestFile, IName);
  117.     Reset (TestFile);
  118.     Size := FileSize (TestFile);
  119.     Close (TestFile);
  120.     IF NOT ((Size = TwoKB) OR (Size = FourKB))
  121.       THEN
  122.         BEGIN
  123.           Writeln ('ERROR! File wrong size.');
  124.           Exit;
  125.         END;
  126.     Writeln ('Press any key to terminate...');
  127.     Delay (2000);
  128.     IF Size = TwoKB
  129.       THEN
  130.         BEGIN
  131.           Assign (N_InFile, IName);
  132.           Reset (N_InFile);
  133.           Read (N_InFile, N_Picture);
  134.           Close (N_InFile);
  135.           TextMode (1);             { SET TO 40 COLUMNS }
  136.           N_InPtr ^ := N_Picture;   { TRANSFER PICTURE DATA }
  137.         END
  138.       ELSE
  139.         BEGIN
  140.           Assign (W_InFile, IName);
  141.           Reset (W_InFile);
  142.           Read (W_InFile, W_Picture);
  143.           Close (W_InFile);
  144.           Port [$3D8] := $25;       { VIDEO OFF - USE IF VIDEO "SNOWS" }
  145.           W_InPtr ^ := W_Picture;   { TRANSFER PICTURE DATA }
  146.           Port [$3D8] := $2D;       { VIDEO ON - USE IF VIDEO "SNOWS" }
  147.         END;
  148.     REPEAT
  149.     UNTIL KeyPressed;
  150.     TextMode (3);                   {RESET VIDEO }
  151.   END.      { Show_Pic }
  152.  
  153.  
  154.